Shareware Grab Bag/Shareware Grab Bag.iso/001/pibt3sp2.arc/PIBDIR.PAS

Pascal/Delphi Source File | 1985-10-04 | 39.6 KB | 827 lines

(*----------------------------------------------------------------------*)
(*        PIBDIR.PAS --- MSDOS Directory Routines for Turbo Pascal      *)
(*----------------------------------------------------------------------*)
(*                                                                      *)
(*  Author:  Philip R. Burns                                            *)
(*  Version: 1.0  (January,1985)                                        *)
(*           2.0  (June,1985)                                           *)
(*  Systems: For MS-DOS on IBM PCs and close compatibles only.          *)
(*           Note:  I have checked these on Zenith 151s under           *)
(*                  MSDOS 2.1 and IBM PCs under PCDOS 2.0.              *)
(*                                                                      *)
(*  Needs:   Global types from GLOBTYPE.PAS.                            *)
(*                                                                      *)
(*  History: Original with me.                                          *)
(*                                                                      *)
(*           Suggestions for improvements or corrections are welcome.   *)
(*           Please leave messages on Gene Plantz's BBS [phone]  *)
(*           or Ron Fox's BBS [phone].                           *)
(*                                                                      *)
(*           IF you use this code in your own programs, please be nice  *)
(*           and give proper credit.                                    *)
(*                                                                      *)
(*----------------------------------------------------------------------*)
(*                                                                      *)
(*  Routines:                                                           *)
(*                                                                      *)
(*      Convert_AsciiZ_To_String                                        *)
(*      Convert_String_To_AsciiZ                                        *)
(*      Dir_Get_Default_Drive                                           *)
(*      Dir_Set_Default_Drive                                           *)
(*      Dir_Get_Current_Path                                            *)
(*      Dir_Set_Current_Path                                            *)
(*      Dir_Set_Disk_Transfer_Address                                   *)
(*      Dir_Delete_File                                                 *)
(*      Dir_Count_Drives                                                *)
(*      Dir_Convert_Time                                                *)
(*      Dir_Convert_Date                                                *)
(*      Dir_Find_First_File                                             *)
(*      Dir_Find_Next_File                                              *)
(*      Dir_Get_Free_Space                                              *)
(*      Dir_Set_File_Date_And_Time                                      *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

(*----------------------------------------------------------------------*)
(*                  Map of MsDos Directory Entry                        *)
(*----------------------------------------------------------------------*)

TYPE

   Directory_Record = RECORD
                         Filler    : ARRAY[1..21] Of BYTE;
                         File_Attr : BYTE;
                         File_Time : INTEGER;
                         File_Date : INTEGER;
                         File_Size : ARRAY[1..2] Of INTEGER;
                         File_Name : ARRAY[1..80] Of CHAR;
                      END;

CONST
   Dir_Attr_Read_Only    =  1;
   Dir_Attr_Hidden       =  2;
   Dir_Attr_System       =  4;
   Dir_Attr_Volume_Label =  8;
   Dir_Attr_Subdirectory = 16;
   Dir_Attr_Archive      = 32;

(*----------------------------------------------------------------------*)
(*   Convert_AsciiZ_To_String -- Convert Ascii Z string to Turbo String *)
(*----------------------------------------------------------------------*)

PROCEDURE Convert_AsciiZ_To_String( VAR S: AnyStr );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Convert_AsciiZ_To_String                             *)
(*                                                                      *)
(*     Purpose:    Convert Ascii Z string to Turbo String               *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Convert_AsciiZ_To_String( VAR S: AnyStr );                    *)
(*                                                                      *)
(*           S --- Ascii Z string to be turned into Turbo string        *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        None                                                          *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*        The string S is assumed to have already received the Ascii Z  *)
(*        string in its [1]st thru [l]th locations.                     *)
(*        This routine searches for the 0-character marking the end of  *)
(*        the string and changes the Turbo string length (in S[0]) to   *)
(*        reflect the actual string length.                             *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   I: INTEGER;

BEGIN (* Convert_AsciiZ_To_String *)

   I := 1;
   WHILE( S[I] <> CHR(0) ) DO I := I + 1;

   S[0] := CHR( I - 1 );

END   (* Convert_AsciiZ_To_String *);

(*----------------------------------------------------------------------*)
(*   Convert_String_To_AsciiZ -- Convert Turbo string to Ascii Z String *)
(*----------------------------------------------------------------------*)

PROCEDURE Convert_String_To_AsciiZ( VAR S: AnyStr );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Convert_String_To_AsciiZ                             *)
(*                                                                      *)
(*     Purpose:    Convert Turbo string to ascii Z string               *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Convert_String_To_AsciiZ( VAR S: AnyStr );                    *)
(*                                                                      *)
(*           S --- Turbo string to be turned into Ascii Z string        *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        None                                                          *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

BEGIN (* Convert_String_To_AsciiZ *)

   S := S + CHR( 0 );

END   (* Convert_String_To_AsciiZ *);

(*----------------------------------------------------------------------*)
(*     Dir_Get_Current_Path -- Get current directory path name          *)
(*----------------------------------------------------------------------*)

FUNCTION Dir_Get_Current_Path( Drive         : CHAR;
                               VAR Path_Name : AnyStr ) : INTEGER;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Dir_Get_Current_Path                                 *)
(*                                                                      *)
(*     Purpose:    Gets text of current directory path name             *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Iok := Dir_Get_Current_Path( Drive : CHAR;                    *)
(*                                     VAR Path_Name : AnyStr ) :       *)
(*                                     INTEGER;                         *)
(*                                                                      *)
(*           Drive      --- Drive to look on                            *)
(*           Path_Name  --- returned current path name                  *)
(*                                                                      *)
(*           Iok        --- 0 if all went well, else DOS return code    *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        MsDos                                                         *)
(*        Convert_String_To_AsciiZ                                      *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Dir_Reg: RegPack;

BEGIN (* Dir_Get_Current_Path *)

    Dir_Reg.Ah := $47;
    Dir_Reg.Ds := SEG( Path_Name[1] );
    Dir_Reg.Si := OFS( Path_Name[1] );
    Dir_Reg.Dl := ORD( UpCase( Drive ) ) - ORD( '@' );

    MsDos( Dir_Reg );

    IF ( Carry_Flag AND Dir_Reg.Flags ) = 0 THEN
       BEGIN
          Dir_Get_Current_Path := 0;
          Convert_AsciiZ_To_String( Path_Name );
       END
    ELSE
       Dir_Get_Current_Path := Dir_Reg.Ax;

END   (* Dir_Get_Current_Path *);

(*----------------------------------------------------------------------*)
(*     Dir_Set_Current_Path -- Set current directory path name          *)
(*----------------------------------------------------------------------*)

FUNCTION Dir_Set_Current_Path( Path_Name : AnyStr ) : INTEGER;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Dir_Set_Current_Path                                 *)
(*                                                                      *)
(*     Purpose:    Sets new current directory path name                 *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Iok := Dir_Set_Current_Path( Path_Name : AnyStr ) :           *)
(*                                     INTEGER;                         *)
(*                                                                      *)
(*           Path_Name  --- New current path name                       *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        MsDos                                                         *)
(*        Convert_AsciiZ_To_String                                      *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Dir_Reg: RegPack;
   I      : INTEGER;

BEGIN (* Dir_Set_Current_Path *)

   Convert_String_To_AsciiZ( Path_Name );

   Dir_Reg.Ah := $3B;
   Dir_Reg.Ds := SEG( Path_Name[1] );
   Dir_Reg.Dx := OFS( Path_Name[1] );

   MsDos( Dir_Reg );

   IF ( Carry_Flag AND Dir_Reg.Flags ) = 0 THEN
      Dir_Set_Current_Path := 0
   ELSE
      Dir_Set_Current_Path := Dir_Reg.Ax;

END   (* Dir_Set_Current_Path *);


(*----------------------------------------------------------------------*)
(*     Dir_Set_Disk_Transfer_Address --- Set DMA address for disk I/O   *)
(*----------------------------------------------------------------------*)

PROCEDURE Dir_Set_Disk_Transfer_Address( VAR DMA_Buffer );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Dir_Set_Disk_Transfer_Address                        *)
(*                                                                      *)
(*     Purpose:    Sets DMA address for disk transfers                  *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Dir_Set_Disk_Transfer_Address( VAR DMA_Buffer );              *)
(*                                                                      *)
(*           DMA_Buffer --- direct memory access buffer                 *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        MsDos                                                         *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Dir_Reg: RegPack;

BEGIN (* Dir_Set_Disk_Transfer_Address *)

   Dir_Reg.Ax := $1A00;
   Dir_Reg.Ds := SEG( DMA_Buffer );
   Dir_Reg.Dx := OFS( DMA_Buffer );

   MsDos( Dir_Reg );

END   (* Dir_Set_Disk_Transfer_Address *);

(*----------------------------------------------------------------------*)
(*            Dir_Set_Default_Drive --- Set Default Drive               *)
(*----------------------------------------------------------------------*)

PROCEDURE Dir_Set_Default_Drive( Drive: Char );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Dir_Set_Default_Drive                                *)
(*                                                                      *)
(*     Purpose:    Sets default drive for disk I/O                      *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Dir_Set_Default_Drive( Drive : Char );                        *)
(*                                                                      *)
(*           Drive --- letter of default drive                          *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        MsDos                                                         *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Dir_Reg: RegPack;

BEGIN  (* Dir_Set_Default_Drive *)

   Dir_Reg.Ah := $0E;
   Dir_Reg.Dl := ORD( UpCase( Drive ) ) - ORD( 'A' );

   MsDos( Dir_Reg );

END   (* Dir_Set_Default_Drive *);


(*----------------------------------------------------------------------*)
(*            Dir_Get_Default_Drive --- Get Default Drive               *)
(*----------------------------------------------------------------------*)

FUNCTION Dir_Get_Default_Drive: CHAR;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:  Dir_Get_Default_Drive                                 *)
(*                                                                      *)
(*     Purpose:   Gets default drive for disk I/O                       *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Def_Drive := Dir_Get_Default_Drive : CHAR;                    *)
(*                                                                      *)
(*           Def_Drive --- Letter of default drive                      *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        MsDos                                                         *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Dir_Reg: RegPack;

BEGIN  (* Dir_Get_Default_Drive *)

   Dir_Reg.Ah := $19;

   MsDos( Dir_Reg );

   Dir_Get_Default_Drive := CHR( Dir_Reg.Al + ORD( 'A' ) );

END   (* Dir_Get_Default_Drive *);

(*----------------------------------------------------------------------*)
(*            Dir_Delete_File --- Delete A File                         *)
(*----------------------------------------------------------------------*)

FUNCTION Dir_Delete_File( File_Name : AnyStr ) : INTEGER;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:  Dir_Delete_File                                       *)
(*                                                                      *)
(*     Purpose:   Deletes file in current directory                     *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Ideleted := Dir_Delete_File( File_Name : AnyStr ): INTEGER;   *)
(*                                                                      *)
(*           File_Name --- name of file to delete                       *)
(*           Ideleted  --- 0 if delete goes OK, else MSDOS return code  *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        MsDos                                                         *)
(*        Convert_String_To_AsciiZ                                      *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Dir_Reg: RegPack;

BEGIN  (* Dir_Delete_File *)

   Convert_String_To_AsciiZ( File_Name );

   Dir_Reg.Ah := $41;
   Dir_Reg.Ds := SEG( File_Name[1] );
   Dir_Reg.Dx := OFS( File_Name[1] );

   MsDos( Dir_Reg );

   IF ( Carry_Flag AND Dir_Reg.Flags ) = 0 THEN
      Dir_Delete_File := 0
   ELSE
      Dir_Delete_File := Dir_Reg.Ax;

END   (* Dir_Delete_File *);

(*----------------------------------------------------------------------*)
(*            Dir_Count_Drives --- Count number of drives in system     *)
(*----------------------------------------------------------------------*)

FUNCTION Dir_Count_Drives : INTEGER;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:  Dir_Count_Drives                                      *)
(*                                                                      *)
(*     Purpose:   Finds number of installed DOS drives                  *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        ndrives := Dir_Count_Drives : INTEGER;                        *)
(*                                                                      *)
(*           ndrives --- number of drives in system                     *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        MsDos                                                         *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Dir_Reg: RegPack;

BEGIN  (* Dir_Count_Drives *)

   Dir_Reg.Ah := $19;

   MsDos( Dir_Reg );

   Dir_Reg.Ah := $0E;
   Dir_Reg.Dl := Dir_Reg.Al;

   MsDos( Dir_Reg );

   Dir_Count_Drives := Dir_Reg.Al;

END   (* Dir_Count_Drives *);


(*----------------------------------------------------------------------*)
(*            Dir_Convert_Time --- Convert directory creation time      *)
(*----------------------------------------------------------------------*)

PROCEDURE Dir_Convert_Time ( Time : INTEGER; VAR S_Time : AnyStr );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure: Dir_Convert_Time                                      *)
(*                                                                      *)
(*     Purpose:   Convert creation time from directory to characters.   *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Dir_Convert_Time( Time       : INTEGER;                       *)
(*                          VAR S_Time : AnyStr ) : INTEGER;            *)
(*                                                                      *)
(*           Time   --- time as read from directory                     *)
(*           S_Time --- converted time in hh:mm:ss                      *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        STR                                                           *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   HH : String[2];
   MM : String[2];
   SS : String[2];

BEGIN (* Dir_Convert_Time *)

   STR( ( Time SHR 11 ):2 , HH );
   IF HH[1] = ' ' THEN HH[1] := '0';

   STR( ( ( Time AND $07E0 ) SHR 5 ):2 , MM );
   IF MM[1] = ' ' THEN MM[1] := '0';

   STR( ( ( Time AND $001F ) * 2 ):2 , SS );
   IF SS[1] = ' ' THEN SS[1] := '0';

   S_Time := HH + ':' + MM + ':' + SS;

END  (* Dir_Convert_Time *);

(*----------------------------------------------------------------------*)
(*            Dir_Convert_Date --- Convert directory creation date      *)
(*----------------------------------------------------------------------*)

PROCEDURE Dir_Convert_Date ( Date : INTEGER; VAR S_Date : AnyStr );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure: Dir_Convert_Date                                      *)
(*                                                                      *)
(*     Purpose:   Convert creation date from directory to characters.   *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Dir_Convert_Date( Date       : INTEGER;                       *)
(*                          VAR S_Date : AnyStr ) : INTEGER;            *)
(*                                                                      *)
(*           Date   --- date as read from directory                     *)
(*           S_Date --- converted date in yy/mm/dd                      *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        STR                                                           *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   YY : String[2];
   MM : String[2];
   DD : String[2];

BEGIN (* Dir_Convert_Date *)

   STR( ( 80 + ( Date SHR 9 ) ) : 2 , YY );

   STR( ( ( Date AND $01E0 ) SHR 5 ):2 , MM );
   IF MM[1] = ' ' THEN MM[1] := '0';

   STR( ( Date AND $001F ):2 , DD );
   IF DD[1] = ' ' THEN DD[1] := '0';

   S_Date := YY + '/' + MM + '/' + DD;

END  (* Dir_Convert_Date *);

(*----------------------------------------------------------------------*)
(*   Dir_Find_First_File --- Find First File Matching Given Specs       *)
(*----------------------------------------------------------------------*)

FUNCTION Dir_Find_First_File(     File_Pattern: AnyStr;
                              VAR First_File  : Directory_Record  ):
                              INTEGER;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Dir_Find_First_File                                  *)
(*                                                                      *)
(*     Purpose:    Find first file in directory matching specs          *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Iok := Dir_Find_First_File(     File_Pattern: AnyStr;         *)
(*                                    VAR First_File  :                 *)
(*                                        Directory_Record ): INTEGER;  *)
(*                                                                      *)
(*           File_Pattern --- File pattern to look for.                 *)
(*           First_File   --- First file matching specs.                *)
(*           Iok          --- 0 if file found, else MsDos return code.  *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        Dir_Set_Disk_Transfer_Address                                 *)
(*        MsDos                                                         *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*        The file pattern can be any standard MSDOS file pattern,      *)
(*        including wildcards.  For a complete directory list, enter    *)
(*        '*.*' as the pattern.   Use routine 'Dir_Find_Next_File'      *)
(*        to get the remaining files.                                   *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Dir_Reg: RegPack;

BEGIN (* Find_First_File *)

   Dir_Set_Disk_Transfer_Address( First_File );

   Convert_String_To_AsciiZ( File_Pattern );

   Dir_Reg.Ds := SEG( File_Pattern[1] );
   Dir_Reg.Dx := OFS( File_Pattern[1] );
   Dir_Reg.Ax := $4E00;
   Dir_Reg.Cx := $FF;

   MsDos( Dir_Reg );

   IF ( Carry_Flag AND Dir_Reg.Flags ) = 0 THEN
      Dir_Find_First_File := 0
   ELSE
      Dir_Find_First_File := Dir_Reg.Ax;

END   (* Find_First_File *);


(*----------------------------------------------------------------------*)
(*     Dir_Find_Next_File  --- Find Next File Matching Given Specs      *)
(*----------------------------------------------------------------------*)

FUNCTION Dir_Find_Next_File ( VAR Next_File : Directory_Record ) : INTEGER;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Dir_Find_Next_File                                   *)
(*                                                                      *)
(*     Purpose:    Finds next file in directory matching specs          *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Iok := Dir_Find_Next_File ( VAR Next_File :                   *)
(*                                        Directory_Record ) : INTEGER; *)
(*                                                                      *)
(*           Next_File    --- Next file matching specs.                 *)
(*           Iok          --- Returned as 0 if file found, else MsDos   *)
(*                            return code indicating error.             *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        MsDos                                                         *)
(*        Dir_Set_Disk_Transfer_Address                                 *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Dir_Reg : RegPack;

BEGIN (* Find_Next_File  *)

   Dir_Set_Disk_Transfer_Address( Next_File );

   Dir_Reg.Ax := $4F00;

   MsDos( Dir_Reg );

   IF ( Carry_Flag AND Dir_Reg.Flags ) = 0 THEN
      Dir_Find_Next_File := 0
   ELSE
      Dir_Find_Next_File := Dir_Reg.Ax;

END   (* Find_Next_File  *);

(*----------------------------------------------------------------------*)
(*     Dir_Get_Free_Space  --- Find Next File Matching Given Specs      *)
(*----------------------------------------------------------------------*)

FUNCTION Dir_Get_Free_Space ( Drive : CHAR ) : REAL;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Dir_Get_Free_Space                                   *)
(*                                                                      *)
(*     Purpose:    Gets amount of available space on a drive            *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        FSpace := Dir_Get_Free_Space ( Drive : CHAR ) : REAL;         *)
(*                                                                      *)
(*           Drive        --- Drive letter for which to get free space  *)
(*           Fspace       --- Returned number of bytes of free space    *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        MsDos                                                         *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*         If the free space can't be found, -1 is returned.            *)
(*         This is most likely to happen if an unformatted or wrongly   *)
(*         formatted disk is to be checked.                             *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Dir_Reg  : RegPack;
   Clusters : REAL;
   Sectors  : REAL;
   Bytes    : REAL;

BEGIN (* Dir_Get_Free_Space  *)

                                   (* Request drive information *)

   Dir_Reg.DL := ORD(UpCase( Drive )) - ORD('A') + 1;
   Dir_Reg.AH := $36;

   MsDos( Dir_Reg );

                                   (* Compute free space *)

   WITH Dir_Reg DO
      BEGIN

         Sectors  := AX;
         Clusters := BX;
         Bytes    := CX;

         IF AX = $FFFF THEN
            Dir_Get_Free_Space := -1.0
         ELSE
            Dir_Get_Free_Space := Clusters * Bytes * Sectors;

      END;

END   (* Dir_Get_Free_Space  *);

(*----------------------------------------------------------------------*)
(*     Dir_Set_File_Date_And_Time -- Set file date and time stamp       *)
(*----------------------------------------------------------------------*)

FUNCTION Dir_Set_File_Date_And_Time( File_Handle: INTEGER;
                                     File_Date  : INTEGER;
                                     File_Time  : INTEGER  ) : INTEGER;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Dir_Set_File_Date_And_Time                           *)
(*                                                                      *)
(*     Purpose:    Sets file time and date stamp                        *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Error := Dir_Set_File_Date_And_Time( File_Handle: INTEGER;    *)
(*                                             File_Date  : INTEGER;    *)
(*                                             File_Time  : INTEGER ):  *)
(*                                             INTEGER;                 *)
(*                                                                      *)
(*           File_Handle --- File handle of file to set time/date on    *)
(*           File_Date   --- File date in packed DOS form               *)
(*           File_Time   --- File time in packed DOS form               *)
(*           Error       --- DOS error return code                      *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        MsDos                                                         *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Dir_Reg  : RegPack;

BEGIN (* Dir_Set_File_Date_And_Time *)

                                   (* Set up parameters to DOS call *)
   WITH Dir_Reg DO
      BEGIN
         Cx := File_Time;
         Dx := File_Date;
         Bx := File_Handle;
         Ah := $57;
         Al := 1;
      END;
                                   (* Set date and time *)
   MsDos( Dir_Reg );
                                   (* Check for bad return  *)

   IF ( Carry_Flag AND Dir_Reg.Flags ) = 0 THEN
      Dir_Set_File_Date_And_Time := 0
   ELSE
      Dir_Set_File_Date_And_Time := Dir_Reg.Ax;

END   (* Dir_Set_File_Date_And_Time *);

(*----------------------------------------------------------------------*)
(*     Dir_Get_File_Date_And_Time -- Get file date and time stamp       *)
(*----------------------------------------------------------------------*)

FUNCTION Dir_Get_File_Date_And_Time(     File_Handle: INTEGER;
                                     VAR File_Date  : INTEGER;
                                     VAR File_Time  : INTEGER  ) : INTEGER;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Function:   Dir_Get_File_Date_And_Time                           *)
(*                                                                      *)
(*     Purpose:    Gets file time and date stamp                        *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Error := Dir_Get_File_Date_And_Time(     File_Handle: INTEGER;*)
(*                                             VAR File_Date  : INTEGER;*)
(*                                                 File_Time  : INTEGER *)
(*                                           ): INTEGER;                *)
(*                                                                      *)
(*           File_Handle --- File handle of file to set time/date on    *)
(*           File_Date   --- File date in packed DOS form               *)
(*           File_Time   --- File time in packed DOS form               *)
(*           Error       --- DOS error return code                      *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        MsDos                                                         *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Dir_Reg  : RegPack;

BEGIN (* Dir_Get_File_Date_And_Time *)

                                   (* Set up parameters to DOS call *)
   WITH Dir_Reg DO
      BEGIN
         Bx := File_Handle;
         Ah := $57;
         Al := 0;
      END;
                                   (* Get date and time *)
   MsDos( Dir_Reg );
                                   (* Check for bad return  *)

   IF ( Carry_Flag AND Dir_Reg.Flags ) = 0 THEN
      BEGIN
         Dir_Get_File_Date_And_Time := 0;
         File_Time                  := Dir_Reg.Cx;
         File_Date                  := Dir_Reg.Dx;
      END
   ELSE
      BEGIN
         Dir_Get_File_Date_And_Time := Dir_Reg.Ax;
         File_Time                  := 0;
         File_Date                  := 0;
      END;

END   (* Dir_Get_File_Date_And_Time *);